home *** CD-ROM | disk | FTP | other *** search
/ PC Media 2 / PC MEDIA CD02.iso / share / prog / baklpt / tbaklpt.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-08-02  |  2.6 KB  |  83 lines
  1. {$R+,S+,I+,D+,F-,V-,B-,N-,L- }
  2. {$M $1000,65535,327680 }
  3. {
  4.   ** TBakLPT Program  **
  5.   ** by Richard S. Sadowsky      CIS [74017,1670]
  6.   ** 8/3/88
  7.   ** version .6
  8.   ** Copyright 1988, Richard S. Sadowsky
  9.  
  10.   This program is designed as a test and example of the BakLPT unit.
  11.   This program sends some lines to the printer, then begins writing
  12.   astericks to the screen while it prints in the background.  Pressing any
  13.   key will will cause the main block to exit.  This triggers the BakLPT
  14.   ExitProc, which Closes the Lst device.  If unprinted characters remain
  15.   in the buffer, the standard Error handler in BakLPTST is called to ask
  16.   the user what to do.
  17. }
  18. program TestBakLpt;
  19.  
  20. uses TPCrt,BakLpt,BakLptStandard;
  21.  
  22. var
  23.   S                : String;
  24.   X,Y              : Byte;
  25.   I                : Word;
  26.  
  27. const
  28.   Count            : LongInt = 0;
  29.  
  30. begin
  31.   if not BakLPTInstalled then begin   { make sure ISRs are installed }
  32.     WriteLn('ISRs not initialized.');
  33.     Halt
  34.   end;
  35.  
  36.   { make sure Queueing system initialized OK.  Would fail if insufficient }
  37.   { heap space for Queue buffers and ISR stacks }
  38.   if QueError <> 0 then begin
  39.     WriteLn('Queue Error ',QueError);
  40.     Halt
  41.   end;
  42. (*
  43.   QueUserExitFunc := @QueExit; { set the que exit function.  this function }
  44.                                { gets called when the Lst file is closed   }
  45.                                { and unprinted characters remain in the    }
  46.                                { queue buffer.  When QueExit returns TRUE, }
  47.                                { the program may terminate. Note how       }
  48.                                { QueExit waits for queue to empty before   }
  49.                                { exiting if user does not wish to abort.   }
  50.   QueUserErrorFunc:= @QueErrFunc;
  51. *)
  52.   S := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!@#$%^&*()]{};<>,.';
  53.   Write('Line ==> ');
  54.   X := WhereX;
  55.   Y := WhereY;
  56.   repeat
  57.     Inc(Count);
  58.     GotoXY(X,Y);
  59.     Write(Count);
  60.     WriteLn(Lst,'Line ',Count:2,': ',S);
  61.   until (QueError <> 0) or (BakError <> 0) or (QBI > 800);
  62.   if (QueError <> 0) or (BakError <> 0) then begin
  63.     WriteLn('Queue Error ',QueError);
  64.     WriteLn('BakError    ',BakError);
  65.     Halt
  66.   end;
  67.  
  68.   { won't get here until all the characters have been printer }
  69.  
  70.   while (not keypressed) and (BakError = 0) do begin
  71.     clrscr;
  72.     WriteLn('====> Press any key to try to quit <====');
  73.     for I := 1 to 1920 do Write('*');
  74.   end; {while}
  75.   if BakError <> 0 then begin
  76.     WriteLn;
  77.     WriteLn('BakError    ',BakError);
  78.   end
  79.   else
  80.     if ReadKey = ' ' then ; { clear keystroke }
  81.   WriteLn;
  82. end.
  83.